home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / GW AdaEd 1.4.2 / GWAdaDemos / NYUDemos / PI.ADA < prev    next >
Text File  |  1993-01-31  |  1KB  |  74 lines
  1. generic
  2.    type real is digits <>;
  3. function sqrt(y : real) return real;
  4.  
  5. function sqrt(y : real) return real is
  6.    x, t : real := y;
  7. begin
  8.    if y < 0.0 then 
  9.       raise NUMERIC_ERROR;
  10.    else
  11.       loop
  12.      t := (x + y / x)/ 2.0;
  13.      exit when abs(x - t) <= real'epsilon;
  14.      x := t;
  15.       end loop;
  16.       return x;
  17.    end if;
  18. end sqrt;
  19.  
  20. with sqrt;
  21. with text_io; use text_io;
  22. procedure main is
  23.  
  24.    package real_io is new FLOAT_IO(float);
  25.    use real_io;
  26.  
  27.    package int_io is new INTEGER_IO(integer);
  28.    use int_io;
  29.  
  30.    epsilon : constant := float'epsilon;
  31.  
  32.    function sqrt is new sqrt(float);
  33.  
  34.    procedure pi_comp is
  35.  
  36.       pi : float := 1.0;
  37.       n  : integer := 1;
  38.       temp : float;
  39.       sum : float := 1.0;
  40.  
  41.    begin
  42.       loop
  43.  
  44.     n := n + 2;
  45.     temp := 1.0 / float(n) ** 4;
  46.  
  47.     put("Term number ");
  48.     put((n + 1)/2);
  49.     put(" is: ");
  50.     put(temp);
  51.     new_line;
  52.  
  53.     exit when temp <= epsilon;
  54.  
  55.         sum := sum + temp;
  56.  
  57.       end loop;
  58.  
  59.       put("The sum is: ");
  60.       put(sum);
  61.       new_line;
  62.  
  63.       pi := sqrt(sqrt(96.0 * sum));
  64.  
  65.       put("The value of PI is ");
  66.       put(pi);
  67.       new_line;
  68.  
  69.    end pi_comp;
  70.  
  71. begin
  72.    pi_comp;
  73. end main;
  74.